00100	;Floppy disk directory routines.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	.INSERT SYSDEF.FAI[CMS,LCS]
00400	
00500	   ZERO ← 274	;Fail offset
00600	
00700	   LOC ZERO+21
00800	CHR:	0	;Shifter temp. reg.
00900		0	;CUR
01000		0
01100	SHFLOC:	0	;Shift lock bit
01200	STOP:	JMP	STOP	;Go nowhere fast.
01300	FLAD:	0	;Disk buffer pointer
01400		0
01500	XU:	0	;Exec mode
01600	WFOPEN:	0	;Write file open flag
01700	OSEC:	0
01800	FLEN:	0
01900	UFLG:	0	;Program interrupt enable flag.
02000	MFLG:	0	;Modem / SI/O flag.
02100	
02200	   LOC ZERO+40
02300	FBLK:	0	;File block
02400	FNAM:	BLOCK 11	;9 Chr file name.
02500	FTRK:	0	;Disk track number
02600	FSEC:	0	;Disk sector number
02700	NSEC:	0	;Number of sectors
02800	
02900	   LOC ZERO+60
03000	DBUF:	0	;Directory buffer
03100	SCNT:	0	;Number of sectors
03200	FCNT:	0	;Number of files
03300	FFDIR:	0	;First free directory block
03400	FFTRK:	0	;First free track
03500	FFSEC:	0	;First free sector
     

00100	   LOC ZERO+200
00200	FBUF:		;Disk buffer
00300	
00400	   LOC ZERO+174000	;Start of 1k prom block.
00500	
00600	;Power on reset.
00700	STAR:	LDAI	14	;Reset display
00800		STA	DPYRAS
00900		LDAI	377
01000		STA	DPYROW
01100		LDAI	120	;Default display control bits.
01200		STA	DPYCON
01300		LDAI	4
01400		STA	DPYMUX
01500		LDAI	15
01600		STA	KBC
01700		LDAI	15	;Baud rate generator
01800		STA	BRG0
01900		STA	BRG1
02000		LDXI	3	;Reset ACIA
02100		STX	ACIAC
02200		STA	ACIAC	;Control word
02300	
02400		LDXI	2
02500	IDLMOV:	LDAZX	IJMP
02600		STAZX	STOP
02700		DEX
02800		BPL	IDLMOV
02900	
03000		LDAI	200	;Setup display cursor
03100		STAZ	CURH
03200	
03300		CLI
03400	IJMP:	JMP	STOP
     

00100	;Fix IRQV and NMIV for prom.
00200	?  RLOC ← 2	;High byte of origin address
00300	
00400	IRQV:	STAZ	3	;IRQ vector. Save A
00500		JMP	IPOLL
00600	
00700	NMIV:	PLA		;Non maskable interrupt vector
00800		PLA	;Flush stack
00900		PLA
01000		LDXI	0	;For ENDSK
01100		JSR	ENDSK	;Reset disk, timer. Read status
01200		JMP	RERR	;Return with error
01300	
01400	IPOLL:	BIT	KBC	;Check if keyboard
01500		BMI	RKEY
01600		JMP	177432	;Jump to DDT
01700	
01800	RKEY:	PHA	;Save registers
01900		TYA
02000		PHA
02100		TXA
02200		PHA
02300		LDA	KBD	;Read keyboard
02400	
02500		CMPI	352	;<Clear>
02600		BNE	CKX
02700		STAZ	XU	;Set exec.
02800		JSR	PCHR	;Echo it.
02900		JSR	CR	;<cr>
03000		LDAI	12	;<lf>
03100		STAZ	UFLG	;Disable program interrupts.
03200	ECHO:	JSR	PCHR
03300		JMP	RTRN
03400	
03500	CKX:	BITZ	XU	;Check mode
03600		BMI	EXEC
03700		BITZ	UFLG	;Check if program int.
03800		BPL	ECHO
03900		JMP	TTYO
04000	
04100	EXEC:	CMPI	15	;<cr>
04200		BNE	ECHO
04300		JSR	PCHR	;Echo it
04400		LDYI	12	;Number of chrs+1 in FNAM
04500	NLOOP:	LDAIY	CUR	;Save file name in FNAM
04600		STAY	37	;FBLK-1
04700		DEY
04800		BNE	NLOOP
04900	
05000		CMPI	40	;Check for <space>
05100		BEQ	GCMD
05200		LDAI	77	;"α
05300		BNE	NOSPC
05400	
05500	GCMD:	LDAIY	CUR	;Get command
05600	
05700	NOSPC:	PHA
05800		LDAI	FMARK	;Setup file mark
05900		STAZ	FBLK
06000		JSR	LF	;Print <lf>.
06100		PLA
     

00100		CMPI	"T"	;Type file
00200		BNE	CKWRT
00300	
00400		JSR	OPIN
00500		BNE	XERR
00600		JSR	DPYDSK	;Setup disk load address
00700	RIT:	JSR	READ	;Read the file
00800		JMP	ECK	;Check for error
00900	
01000	CKWRT:	CMPI	"W"	;Save screen
01100		BNE	CKLOAD
01200	
01300		LDAI	20	;File length in sectors.
01400		JSR	ENTR
01500		BNE	XERR
01600		JSR	DPYDSK	;Setup disk write address
01700		BNE	WIT	;Write it
01800	
01900	CKLOAD:	CMPI	"L"	;Load file
02000		BNE	CKRUN
02100	
02200		JSR	OPIN
02300		BNE	XERR
02400		JSR	ADRSET	;Setup disk read address
02500		BNE	RIT	;Jump and load it
02600	
02700	CKRUN:	CMPI	"R"	;Run program
02800		BNE	CKUN
02900	
03000		JSR	OPIN
03100		BNE	XERR
03200		JSR	ADRSET	;Setup disk read address
03300		JSR	READ	;Load file
03400		BNE	XERR	;Check for error
03500	
03600	   UMEM ← FBUF	;Until more memory
03700		JMP	UMEM	;Jump to program
03800	
03900	CKUN:	CMPI	"U"	;Unload
04000		BNE	XERR	;Exec. error
04100	
04200		LDAI	1	;File length in sectors.
04300		JSR	ENTR
04400		BNE	XERR
04500		JSR	DPYDSK	;Setup disk write address
04600		JSR	XONE	;Until more memory
04700	WIT:	JSR	WRITE	;Write it
04800		BNE	XERR
04900		JSR	CLOZE
05000	ECK:	BEQ	XOFF	;Jump if no error
05100	XERR:	LDAI	77	;Print 
05200		JSR	PCHR
05300	XOFF:	LDAI	0
05400		STAZ	XU	;Reset XU
05500	
05600	RTRN:	PLA
05700		TAX
05800		PLA
05900		TAY
06000		PLA
06100		RTI	;Return
     

00100	DPYDSK:	LDAI	200	;Setup disk buffer address
00200		STAZ	31	;FLAD+1
00300		ASLA	;Clear A
00400		STAZ	FLAD
00500		LDXI	20	;16 sectors.
00600	XSET:	STXZ	NSEC
00700		RTS
00800	
00900	ADRSET:	LDAI	200	;Setup disk buffer address
01000		STAZ	FLAD
01100		ASLA	;Clear A
01200		STAZ	31	;FLAD+1
01300	XONE:	LDXI	1	;X=1 For one sector
01400		BNE	XSET
01500	
01600	   DMARK ← 74	;Directory mark
01700	   FMARK ← 72	;File mark
01800	
01900	LOKUP:	JSR	FWAI	;Check if disk busy
02000		LDAI	364	;Restore track 0
02100		STA	FDSKC
02200		JSR	FWAI
02300	
02400		LDAI	375	;Second sector
02500		STA	FDSKS
02600		JSR	RBUF	;Load one sector into FBUF
02700		BNE	NOHED	;Check for read error
02800	
02900		LDAZ	FBUF	;Check for directory mark
03000		CMPI	DMARK
03100		BNE	NOHED
03200	
03300		LDXI	17
03400	GDIR:	LDAZX	FBUF	;Save first 16 bytes
03500		STAZX	DBUF
03600		DEX
03700		BPL	GDIR
     

00100		LDAZ	SCNT	;Number of sectors in directory
00200		STAZ	NSEC	;Wipe out NSEC
00300		LDYI	20	;BLK Length
00400	
00500	CKDIR:	LDXI	0
00600	
00700	CKNAM:	LDAY	FBUF
00800		CMPZX	FBLK
00900		BNE	NXTF
01000	
01100		INY
01200		INX
01300		CPXI	12
01400		BNE	CKNAM
01500	;File names match so..
01600		LDAY	FBUF	;Get file track number.
01700		STAZ	FTRK
01800		LDAY	201	;FBUF+1
01900		STAZ	FSEC	;File sector number.
02000		LDAY	202	;FBUF+2
02100		STAZ	NSEC	;File length.
02200		TAX
02300		LDAI	0	;File found.
02400		RTS
02500	
02600	NXTF:	TYA
02700		ORAI	17
02800		TAY
02900		INY		;Get next dir entry
03000		BPL	CKDIR	;More in buffer
03100	
03200		DECZ	NSEC	;More sectors
03300		BEQ	FNF
03400	
03500		DEC	FDSKS	;Next sector
03600		JSR	RBUF
03700		BNE	NOHED
03800		LDYI	0
03900		BEQ	CKDIR
04000	
04100	FNF:	LDAI	200	;Not in directory
04200	NOHED:	RTS
     

00100	OPIN:	JSR	LOKUP	;Lookup file FNAM
00200		BNE	RX	;File not found
00300	
00400	SEEK:	LDAZ	FTRK	;Get track and sector
00500		STA	FDSKD
00600		LDAZ	FSEC
00700		STA	FDSKS
00800		LDAI	340	;Seek and verify command
00900		STA	FDSKC
01000	
01100		JSR	FWAI	;Wait and read status
01200		EORI	177
01300		ANDI	354	;Flush index bit, etc.
01400	
01500	RX:	RTS
01600	
01700	;Wait until not busy.
01800	FWAI:	LDA	FDSKC	;Read status
01900		LSRA
02000		BCC	FWAI	;Check if busy
02100		RTS
02200	
02300	SETTO:	JSR	FWAI	;Wait until not busy.
02400	SETT:	LDYI	2	;Setup time out interupt vector
02500		LDAI	PLA
02600	ISET:	STAY	NMIV
02700		DEY
02800		BPL	ISET
02900	
03000		LDAI	377	;Init timer
03100		STA	RTCAH
03200		STA	RTCAC
03300		RTS
     

00100	SETBUF:	LDAI	FBUF	;Read disk into FBUF
00200		STAZ	FLAD	;Setup buffer pointer.
00300		ASLA	;Clear A
00400		STAZ	31	;FLAD+1
00500		LDXI	1	;X=1 For one sector
00600		RTS
00700	
00800	RBUF:	JSR	SETBUF	;Setup address
00900	
01000	;Read sectors from disk.
01100	READ:	JSR	SETTO	;Wait and init time out.
01200		LDAI	143	;IBM read command (n secs)
01300		STA	FDSKC
01400	
01500	RSEC:	LDYI	0
01600	FLOAD:	LDA	DSKSEL	;Check if byte ready
01700		BPL	FLOAD
01800		LDA	FDSKD	;Read byte from disk
01900		STAIY	FLAD
02000		INY
02100		BPL	FLOAD
02200	
02300		LDAZ	FLAD
02400		EORI	200	;Next sector
02500		STAZ	FLAD
02600		BMI	NOPAGE
02700		INCZ	FLAD+1
02800	
02900	NOPAGE:	DEX
03000		BNE	RSEC	;More sectors
03100	
03200	ENDSK:	LDAI	57	;End disk op
03300		STA	FDSKC
03400		STX	RTCAC	;Disable timer
03500		TXA	;Wait for >12 cycles.
03600		DEX	;X = 377
03700		TXA
03800		EOR	FDSKC	;Read disk status
03900		ANDI	376	;For busy bit
04000		RTS
     

00100	;Create file routine
00200	ENTR:	STAZ	FLEN	;Save file length.
00300		JSR	LOKUP	;Check if file already exists.
00400		BEQ	FEXIST	;Check if file exists
00500		CMPI	200	;Not in dir. code
00600		BEQ	GBLK
00700	FEXIST:	LDAI	377	;Return with error
00800		RTS
00900	
01000	GBLK:	LDAZ	FFSEC	;Get first free sector
01100		SEC
01200		SBCZ	FLEN	;Check if it fits on track
01300		CMPI	345
01400		BCS	NOBUMP
01500		DECZ	FFTRK
01600		LDAI	376
01700		STAZ	FFSEC
01800	NOBUMP:	LDAZ	FFSEC
01900		STAZ	FSEC
02000		LDAZ	FFTRK
02100		STAZ	FTRK
02200		JSR	SEEK	;Point to new file
02300		BNE	FEXIST	;Verify
02400		LDAI	377	;Set write file open flag.
02500		STAZ	WFOPEN
02600		LDAI	0	;Return with no errors
02700		RTS
     

00100	WBUF:	JSR	SETBUF	;Write FBUF
00200	
00300	WRITE:	JSR	SETTO	;Wait and init timer.
00400	
00500		LDAI	103	;Write multiple sectors command
00600		STA	FDSKC
00700	
00800	CLRY:	LDYI	0
00900	WLOOP:	LDA	DSKSEL	;Wait until empty
01000		BPL	WLOOP
01100	
01200		LDAIY	FLAD
01300		STA	FDSKD	;Write chr on disk
01400		INY
01500		BPL	WLOOP
01600	
01700	QW:	LDA	DSKSEL	;Wait for 129th DRQ
01800		BPL	QW
01900		STA	FDSKD
02000	
02100		LDAZ	FLAD
02200		EORI	200	;Next sector
02300		STAZ	FLAD
02400		BMI	CKMOR
02500		INCZ	FLAD+1
02600	CKMOR:	DEX		;More sectors
02700		BNE	CLRY
02800	
02900		JSR	ENDSK	;Reset disk, timer. Read status
03000		BNE	WERR	;Verify if no errors
03100	
03200	;Verify disk write
03300	VERIFY:	LDAZ	FSEC	;Reset disk sector number
03400		STA	FDSKS
03500		JSR	SETT	;Set timer
03600		LDXZ	NSEC	;Get number of sectors
03700		LDAI	147	;Read MS, HE.
03800		STA	FDSKC
03900	
04000	NXTS:	LDYI	0
04100	VWAI:	LDA	DSKSEL	;Wait for byte
04200		BPL	VWAI
04300		LDA	FDSKD	;Reset DRQ.
04400		INY
04500		BPL	VWAI	;Done with sector
04600	
04700		DEX
04800		BNE	NXTS	;Done with file
04900	
05000		JSR	ENDSK	;Reset disk, timer. Read status
05100	WERR:	RTS	;Return with error bits
     

00100	CLOZE:	BITZ	WFOPEN	;Check if file open
00200		BMI	UPDIR
00300	RERR:	LDAI	377	;Return with error
00400		RTS
00500	
00600	;Update directory
00700	UPDIR:	LDAI	377	;Get end of directory
00800		STAZ	FTRK
00900		LDXZ	SCNT	;Get sec.
01000		INX
01100		TXA
01200		EORI	377	;Invert it
01300		STAZ	FSEC
01400		STAZ	OSEC	
01500		JSR	SEEK
01600		BNE	RERR	;Seek error
01700		JSR	RBUF	;Read end of directory.
01800		BNE	RERR	;Read error
01900	
02000		LDAZ	FFTRK	;Point to new file
02100		STAZ	FTRK
02200		LDAZ	FFSEC
02300		STAZ	FSEC
02400	
02500		LDXZ	FFDIR
02600	
02700	;BLT FBLK into directory
02800		LDYI	0
02900	NAMEIT:	LDAY	FBLK
03000		STAZX	FBUF
03100		INX
03200		INY
03300		CPYI	20	;FBLK Length
03400		BNE	NAMEIT
03500	
03600		LDXZ	OSEC	;Point to end of directory
03700		STXZ	FSEC
03800	
03900		STX	FDSKS
04000		LDXI	1	;For one sector
04100		STXZ	NSEC
04200		JSR	WBUF	;Write new file record
04300		BNE	RERR	;Check for write error
04400	
04500		CLC
04600		LDAZ	FFDIR
04700		ADCI	20	;Update end of dir.
04800		BPL	SVSEC
04900		LDAI	0
05000		INCZ	SCNT	;Next sector
05100	
05200	SVSEC:	STAZ	FFDIR
05300	
05400		LDAZ	FFSEC
05500		SEC
05600		SBCZ	FLEN	;Point to next free sector.
05700		STAZ	FFSEC
     

00100		LDAI	375	;Point to header.
00200		STAZ	FSEC
00300		STA	FDSKS	;Start of directory
00400		JSR	RBUF	;Read directory header
00500		BNE	RERR	;Check for read error
00600	
00700		LDXI	1
00800		STXZ	NSEC
00900		LDXI	17	;Header length
01000	HLOOP:	LDAZX	DBUF	;BLT Header into directory
01100		STAZX	FBUF
01200		DEX
01300		BPL	HLOOP
01400	
01500		JSR	WBUF	;Write directory
01600		BNE	RERR	;Write error
01700		STAZ	WFOPEN	;Reset write file open flag
01800	
01900		RTS
     

00100	;Print a chr. on mem mapped dpy.
00200	PCHR:	CMPI	12	;<lf>
00300		BEQ	LF
00400		CMPI	14	;<home> Key on S720 keyboard.
00500		BNE	CKCR
00600	LF:	CLC
00700		LDAZ	CUR
00800		ADCI	100	;Next line
00900		STAZ	CUR
01000		BCC	CLIN
01100		INCZ	23	;CUR+1
01200		LDAZ	23	;CUR+1
01300		CMPI	210	;End of DPY mem.
01400		BNE	CLIN
01500		LDAI	200
01600		STAZ	23	;CUR+1
01700	CLIN:	LDYI	77
01800		LDAI	40
01900	CLOOP:	STAIY	CUR	;Clear line
02000		DEY
02100		BPL	CLOOP
02200		BMI	CJUMP	;Update cursor
02300	
02400	CKCR:	CMPI	15	;<cr>
02500		BNE	CKBS
02600	CR:	LDAZ	CUR
02700		ANDI	300
02800		STAZ	CUR
02900	CJUMP:	JMP	UPCUR	;Update cursor
03000	
03100	CKBS:	CMPI	10	;<BS>
03200		BNE	JPIT
03300		JMP	BS
03400	JPIT:	JMP	PIT	;Print it
03500	PIT:	LDYI	0
03600		STAIY	CUR	;Print chr on screen
03700		INCZ	CUR
03800		LDAZ	CUR
03900		ANDI	77
04000		BNE	UPCUR	;Update cursor
04100		DECZ	CUR	;Fix <cr>.
04200		LDAZ	CUR
04300		ANDI	300	;<cr>
04400		STAZ	CUR
04500		JMP	LF	;New line
04600	
04700	BS:	DECZ	CUR	;Back space.
04800	UPCUR:	LDAZ	CUR	;Update cursor
04900		STA	DCURL
05000		LDAZ	CURH
05100		STA	DCURH
05200		RTS
05300	
05400		BLOCK 200	;Zeros
05500	END
     

00100	;Boot strap loader.
00200	BOOTS:	JSR	BWAI	;Wait until not busy.
00300		LDAI	244	;Step track command
00400		STA	FDSKC	;Step to track one.
00500		
00600		LDAI	100	;Load PCHR
00700		STAZ	CUR
00800		LDAI	0
00900		STAZ	CURH
01000		LDAI	357	;PCHR sector number + 1.
01100		STA	FDSKS
01200		JSR	BOSEC	;Read a sector
01300		LDAI	0
01400		STAZ	CUR
01500		LDAI	2
01600		STAZ	CURH
01700		JSR	BOSEC	;IRQV
01800		LDAI	200
01900		STAZ	CUR
02000		JSR	BOSEC
02100		LDAI	0
02200		STAZ	CUR
02300		INCZ	CURH
02400		JSR	BOSEC
02500		LDAI	200
02600		STAZ	CUR
02700		JSR	BOSEC
02800		LDAI	0
02900		STAZ	CUR
03000		LDAI	374
03100		STAZ	CURH
03200		JSR	BOSEC
03300		LDAI	200
03400		STAZ	CUR
03500		JSR	BOSEC
03600		JMP	FBUF	;Jump to start up routine.
03700	BWAI:	LDA	FDSKC	;Read disk status.
03800		LSRA	;Get busy bit
03900		BCC	BWAI
04000		RTS
04100	BOSEC:	JSR	BWAI
04200		DEC	FDSKS	;Next sector
04300		LDYI	0
04400		LDAI	163	;Read one sector command.
04500		STA	FDSKC
04600	BOOLO:	LDA	DSKSEL	;Wait for byte from disk.
04700		BPL	BOOLO
04800		LDA	FDSKD	;Read byte
04900		STAIY	CUR
05000		INY
05100		BPL	BOOLO
05200		JSR	BWAI
05300		EORI	177	;Check for errors
05400		BNE	WEDGE
05500		RTS
05600	WEDGE:	JMP	177415	;Error return to ddt.
     

00100	;Fix clock, delete clock?
00200	CLOCK:	LDXI	2
00300	JSET:	LDAZX	CLKTBL-100000
00400		STAX	NMIV
00500		DEX
00600		BPL	JSET
00700	
00800		LDAI	367
00900		STA	RTCAH
01000		STA	RTCAC
01100		PLA
01200		PLA
01300		PLA
01400		CLI
01500		JMP	STOP
01600	CLKTBL:	JMP	CLOCK-100000
01700	CLKINT:	PHA
01800		BIT	RTCAC
01900		INC	100007
02000		LDA	100007
02100		CMPI	72
02200		BNE	CRTN
02300		LDAI	60
02400		STA	100007
02500		INC	100006
02600		LDA	100006
02700		CMPI	66
02800		BNE	CRTN
02900		LDAI	60
03000		STA	100006
03100		INC	100004
03200		LDA	100004
03300		CMPI	72
03400		BNE	CRTN
03500		LDAI	60
03600		STA	100004
03700		INC	100003
03800		LDA	100003
03900		CMPI	66
04000		BNE	CRTN
04100		LDAI	60
04200		STA	100003
04300		INC	100001
04400		LDA	100001
04500		CMPI	72
04600		BEQ	TENH
04700		CMPI	62
04800		BNE	CRTN
04900		LDA	100000
05000		CMPI	61
05100		BNE	CRTN
05200		DEC	100000
05300		LDAI	61
05400		STA	100001
05500		BNE	CRTN
05600	TENH:	INC	100000
05700	CRTN:	PLA
05800		RTI